Attribute VB_Name = "dialogfunc"
Option Explicit
Type RECT 'Used by GetClientRect and GetWindowRect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Type POINTAPI
x As Long
y As Long
End Type
Type parsedpath
    filetype As String
    FileName As String
    filepath As String
    filenameext As String
    fullfilepath As String
End Type

'----------------------------------------------
'CDM_ constants refer to message values that can
'be sent to the open or save common dialogs to
'set or retrieve values.  They do not apply to
'controls placed on the dialog via a custom template.
'----------------------------------------------
Const WM_USER = &H400
Const CDM_FIRST = (WM_USER + 100)
Const CDM_LAST = (WM_USER + 200)
Const CDM_GETSPEC = (CDM_FIRST + &H0)
Const CDM_GETFILEPATH = (CDM_FIRST + &H1)
Const CDM_GETFOLDERPATH = (CDM_FIRST + &H2)
Const CDM_GETFOLDERIDLIST = (CDM_FIRST + &H3)
Const CDM_SETCONTROLTEXT = (CDM_FIRST + &H4)
Const CDM_HIDECONTROL = (CDM_FIRST + &H5)
Const CDM_SETDEFEXT = (CDM_FIRST + &H6)

'-------------------------------------
'NOTIFY messages are sent to a callback
'function when the user clicks or changes
'standard Open/Save dialog controls.
'COMMAND messages are sent when the user
'clicks or changes added controls.
'--------------------------------------
Const WM_NOTIFY = &H4E
Const WM_COMMAND = &H111
Const WM_SETICON = &H80
Const WM_INITDIALOG = &H110

'--------------------------------------
'Identifies to the callback procedure what
'messages to handle.
'--------------------------------------
Const FileSaveAs = 2
Const FilePick = 7
Const FileMultiPick = 8
Const ChoosePath = 9

Private parsed As parsedpath

'------------------------------------
'notification messages sent by the Open/Save
'dialogs to the callback function.
'------------------------------------
Const CDN_INITDONE = -601
Const CDN_SELCHANGE = -602
Const CDN_FOLDERCHANGE = -603
Const CDN_SHAREVIOLATION = -604
Const CDN_HELP = -605
Const CDN_FILEOK = -606
Const CDN_TYPECHANGE = -607

'-------------------------------------
'Three of the common failures of subclassed
'dialogs:
'-------------------------------------
Const CDERR_FINDRESFAILURE = &H6
Const CDERR_LOADRESFAILURE = &H7
Const CDERR_NOTEMPLATE = &H3

'-------------------------------------
'Flags for the Open/Save Dialog
'-------------------------------------
Const cdlOFNFileMustExist = &H1000
Const cdlOFNExplorer = &H80000
Const cdlOFNHelpButton = &H10
Const cdlOFNHideReadOnly = &H4
Const cdlOFNEnableHook = &H20
Const cdlOFNEnableTemplate = &H40
Public Const cdlOFNAllowMultiselect = &H200
Public Const SubClassed = 1
Public Const Normal = 0

Public DebugMode&

Public Const CC_ENABLEHOOK = &H10
'------------------------------------
'Identifiers for some of the standard
'Open/Save dialog controls.
'------------------------------------
Const ID_OPEN = &H1 'Open or Save button
Const ID_CANCEL = &H2 'Cancel Button
Const ID_HELP = &H40E 'Help Button
Const ID_READONLY = &H410 'Read-only check box
Const ID_FILETYPELABEL = &H441 'Files of type label
Const ID_FILELABEL = &H442 'File name label
Const ID_FOLDERLABEL = &H443 'Look in label
Const ID_LIST = &H461 'Parent of file list
Const ID_FORMAT = &H470 'File type combo box
Const ID_FOLDER = &H471 'Folder combo box
Const ID_FILETEXT = &H480 'File name text box

Const FNERR_BUFFERTOOSMALL = &H3003

Private ChangeDefExt&
Private fileaction&
Public LastLoadedPath$
Public LastSavedPath$
Private filterloadposition&
Private result$
Private Image1FileName$

'-----------------------------------
'Identifiers for the custom template
'and its controls
'-----------------------------------
Public Const DLG_OPENFILE = 40&
Const IDC_LOGOTEXT = 1010
Const IDC_LOGOICON = 1011
Const IDC_BUTTON1 = 1000
Const IDC_CHECK1 = 1003
Const IDC_LABEL1 = 1005

Const SW_HIDE = 0
Const SW_SHOWNORMAL = 1

Public xPixel&
Public yPixel&
Public AutoPreview&
Private saveformat&
Private lRtn&

Public Const cdlCFBoth = &H3&
Public Const cdlCFScreenFonts = &H1&
Public Const cdlCFTTOnly = &H40000
Public Const cdlCFEnableHook = &H8&

Public Const PD_ENABLEPRINTHOOK = &H1000&

'---------------------------
'The NMHDR structure is sent with
'WM_NOTIFY messages
'---------------------------
Type NMHDR
    hwndFrom As Long
    idfrom As Long
    code As Long
End Type

Type OsVersionInfo
    dwVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatform As Long
    szCSDVersion As String * 128
End Type

Public OsVers As OsVersionInfo
Public winOS&
Public Const Win95 = 1&
Public Const WinNT = 2&
Public Const OldNT = 3&


Private Const SPI_GETWORKAREA = 48


Declare Function CheckDlgButton Lib "user32" (ByVal hDlg As Long, ByVal nIDButton As Long, ByVal wCheck As Long) As Long
Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" (ByVal hWndParent&, ByVal hWndChildAfter&, ByVal lpClassName$, ByVal lpWindowName$)
Declare Function FreeLibrary& Lib "kernel32" (ByVal hlibModule&)
Declare Function GetClientRect& Lib "user32" (ByVal hWnd&, lprect As RECT)
Declare Function GetDeviceCaps& Lib "gdi32" (ByVal hdc&, ByVal nIndex&)
Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Declare Function GetParent& Lib "user32" (ByVal hWnd&)
Declare Function GetVersionEx& Lib "kernel32" Alias "GetVersionExA" (lpStruct As OsVersionInfo)
Declare Function GetWindowRect& Lib "user32" (ByVal hWnd&, lprect As RECT)
Declare Function IsDlgButtonChecked Lib "user32" (ByVal hDlg As Long, ByVal nIDButton As Long) As Long
Declare Function LoadLibrary& Lib "kernel32" Alias "LoadLibraryA" (ByVal lpModulename$)
Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Declare Function MessageBoxAPI Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Declare Function ScreenToClient& Lib "user32" (ByVal hWnd&, lpPoint As POINTAPI)
Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam As Any)
Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Declare Function SetParent& Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long)
Declare Function SetWindowText& Lib "user32" Alias "SetWindowTextA" (ByVal hWnd&, ByVal lpText$)
Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Function GetPathInfo$(startpath$)
    fileaction = ChoosePath
    Dim objSaveDialog As New clsCommonDialog
    Dim filterstring$
    filterstring = "All Files|*.*;"
    filterstring = filterstring & "*.*"
    With objSaveDialog
        .Filter = filterstring
        .FilterIndex = 0
        .DialogTitle = "Select Folder"
        .CancelError = True
        If Right$(startpath, 1) = "\" Then
            startpath = Left$(startpath, Len(startpath) - 1)
        End If
        .InitDir = startpath
        .FLAGS = cdlOFNEnableTemplate Or cdlOFNEnableHook Or _
            cdlOFNExplorer Or cdlOFNHelpButton Or _
            cdlOFNHideReadOnly
        .HookAddress = pAddressOf(AddressOf OpenProc)
        .TemplateID = DLG_OPENFILE
        .hWnd = Form1.hWnd
        .FileName = ""
        .ShowSave
        If .ExtendedError <> 0 Then
            GetPathInfo = ""
        Else
            'Strip filename ("\Junk") from the full path and filename
            GetPathInfo = Left$(.FileName, Len(.FileName) - Len(.FileTitle) - 1)
        End If
    End With
    Set objSaveDialog = Nothing

End Function

Public Function CommDlg_OpenSave_GetSpec$(hDlg&)
    '------------------------------------------
    'Returns the file name.  Provided to match
    'the C macro of the same name
    '------------------------------------------
    Dim lpString$, cdRet&
    lpString$ = Space$(260)
    cdRet = SendMessage(GetParent(hDlg), CDM_GETFILEPATH, Len(lpString), lpString)
    CommDlg_OpenSave_GetSpec = sLeftOfNull(lpString)

End Function

Sub doLoadMultiFile()
    On Error GoTo multierror
    Dim filepathx$, sPathtemp$, tempfile$, Picturenumber&
    fileaction = FileMultiPick
    Dim objOpenDialog As New clsCommonDialog
    With objOpenDialog
        .Filter = "All Supported Formats|*.BMP;*.ICO;*.RLE;*.WMF;*.EMF;*.GIF;*.JPG|Windows Bitmap (BMP)|*.BMP|Windows Icons (ICO)|*.ICO|Windows Bitmap (RLE)|*.RLE|Windows Meta File (WMF)|*.WMF|Enhanced Meta File (EMF)|*.EMF|Compuserve (GIF)|*.GIF|JPEG (JPG)|*.JPG"
        .DialogTitle = "Choose Files to open"
        .CancelError = True
        sPathtemp = LastLoadedPath
        If Right$(sPathtemp, 1) = "\" Then
            sPathtemp = Left$(LastLoadedPath, Len(LastLoadedPath) - 1)
        End If
        .InitDir = sPathtemp
        .FilterIndex = filterloadposition
        '----------------------------------------------------------------
        'The default length for the returned file information is 260 characters.
        'With Multiselect turned on, the string may be very long, particularly
        'with long filenames.  This example sets a maximum of 32K characters and
        'triggers a message if it won't fit.  There are provisions for changing
        'the buffer size before the dialog returns, but they are beyond the scope
        'of this sample.  Check SDK documentation for further info.
        '----------------------------------------------------------------
        .MaxFileSize = &H8000&
        .FLAGS = cdlOFNEnableTemplate Or cdlOFNEnableHook Or _
            cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHelpButton Or _
            cdlOFNHideReadOnly Or cdlOFNAllowMultiselect
        If winOS <> OldNT Then
            'NT 3.51 users will not see the subclassed dialog
            .FLAGS = .FLAGS Or _
                cdlOFNEnableTemplate Or cdlOFNEnableHook Or _
                cdlOFNExplorer
            .HookAddress = pAddressOf(AddressOf OpenProc)
            .TemplateID = DLG_OPENFILE
        End If
        .hWnd = Form1.hWnd
        .ShowOpen
        '------------------------------------------
        'The picturebox gets destroyed when the dialog
        'exits, so unload its parent form
        '------------------------------------------
        Unload DlgPic
        result = .FileName
        If .ExtendedError <> 0 Then
            Select Case .ExtendedError
                Case CDERR_FINDRESFAILURE
                    MsgBox "The template resource could not be found"
                Case CDERR_LOADRESFAILURE
                    MsgBox "The template resource could not be loaded"
                Case CDERR_NOTEMPLATE
                    MsgBox "No resource template was specified"
                Case FNERR_BUFFERTOOSMALL
                    MsgBox "Total length of all of the file names exceeded the maximum allowable 32K characters.  Please try again with fewer files)"
            End Select
            result = ""
        End If
    End With
    Set objOpenDialog = Nothing
    If result = "" Then
        Exit Sub
    End If
    '-------------------------------------------------------------------------
    'Return from a Multiselect dialog may be one of two forms:
    'drive\path\filename & chr$(0) when only one file is selected, or
    'drive\path & chr$(0) & filename1 & chr$(0) & filename2 & ...
    'until all files are listed, then 2 null characters to end it.
    'The dialog routines have returned this string with any final
    'null characters stripped off; we will add a null character after
    'the path if there isn't one, for uniform processing.
    '------------------------------------------------------------------------
    If InStr(result, Chr$(0)) = 0 Then
        parsepath result
        result = parsed.filepath & Chr$(0) & parsed.filenameext
    End If
    filepathx = Left$(result, InStr(result, Chr$(0)) - 1)
    result = Right$(result, Len(result) - InStr(result, (Chr$(0)))) & Chr$(0)
    If Right$(filepathx, 1) <> "\" Then filepathx = filepathx & "\"
    LastLoadedPath = filepathx
    '------------------------------------------------------------
    'If this were a real program we should save LastLoaded
    'path to the registry, for loading the next time the program is used.
    '------------------------------------------------------------
    Do Until Len(result) < 2 Or Picturenumber = 3
        Picturenumber = Picturenumber + 1
        tempfile = Left$(result, InStr(result, Chr$(0)) - 1)
        parsepath tempfile
        result = Right$(result, Len(result) - InStr(result, (Chr$(0))))
        Form1.Image1(Picturenumber).Picture = LoadPicture(filepathx & parsed.filenameext)
        Form1.Image1(Picturenumber).Refresh
        If Picturenumber = 1 Then
            Image1FileName = filepathx & parsed.filenameext
        End If
    Loop
    Exit Sub
multierror:
    If Err = 50003 Then
        MsgBox "cannot read JPG or GIF files"
    End If
    Exit Sub
End Sub
Sub parsepath(spec1$)
'1=Drive only (including colon)
'2=Path only (including backslashes)
'3=Drive and path
'4=Base filename
'5=Filename extension
'6=Base filename and extension
Dim isDrive&, isPath&, isFile&, isExt&, tempint%
Dim driv$, pathe$, fille$, exten$, spec$
spec = spec1
    If Mid$(spec, 2, 1) = ":" Then
        driv$ = Left$(spec, 2)
        spec = VBA.Right(spec, Len(spec) - 2)
        isDrive = True
    Else
        isDrive = False
    End If
    If VBA.Left(spec, 1) = "\" Then
        isPath = True
        pathe = "\"
        spec = VBA.Right(spec, Len(spec) - 1)
    Else
        isPath = False
    End If
    Do
        tempint = InStr(spec, "\")
        If Not isPath And tempint > 0 Then
            Exit Sub
        End If
        pathe = pathe + VBA.Left(spec, tempint)
        spec = VBA.Right(spec, Len(spec) - tempint)
    Loop Until tempint = 0
    If Len(spec) = 0 Then
        isFile = False
        isExt = False
    Else
        tempint = InStr(spec, ".")
        If tempint > 0 And tempint >= Len(spec) - 3 And tempint < Len(spec) Then
            exten = Mid$(spec, tempint + 1, (Len(spec) - tempint))
            isExt = True
            spec = VBA.Left(spec, tempint - 1)
        End If
        If Len(spec) = 0 Then
            isFile = False
        Else
            isFile = True
            fille = spec
        End If
    End If
    If isDrive And isPath Then parsed.filepath = LCase$(driv & pathe)
    If isFile Then parsed.FileName = LCase$(fille)
    If isExt Then parsed.filetype = "." & LCase$(exten)
    parsed.filenameext = LCase$(fille & "." & exten)
    parsed.fullfilepath = parsed.filepath + parsed.filenameext

End Sub

Sub PositionSaveControls(hWnd&)
Dim rcDialog As RECT, dlgPoint As POINTAPI
Dim dlgHeight&, rcClient As RECT
    GetWindowRect GetDlgItem(hWnd, IDC_LOGOTEXT), rcDialog
    dlgPoint.x = rcDialog.Left
    dlgPoint.y = rcDialog.Bottom
    ScreenToClient GetParent(hWnd), dlgPoint
    GetWindowRect GetParent(hWnd), rcDialog
    GetClientRect GetParent(hWnd), rcClient
    dlgHeight = dlgPoint.y + rcDialog.Bottom - rcDialog.Top - rcClient.Bottom + 5 '5 pixels below the logo
    MoveWindow GetParent(hWnd), rcDialog.Left, rcDialog.Top, rcDialog.Right - rcDialog.Left, dlgHeight, 0
End Sub

Public Function sLeftOfDoubleNull(ByVal sIn As String)
    'returns the part of sIn preceding Chr$(0)chr$(0)
    Dim lNullPos As Long
    
    'init output
    sLeftOfDoubleNull = sIn
    
    'get position of first Chr$(0) in sIn
    lNullPos = InStr(sIn, Chr$(0) & Chr$(0))
    
    'return part of sIn to left of first double Chr$(0) if found
    If lNullPos > 0 Then
        sLeftOfDoubleNull = Mid$(sIn, 1, lNullPos - 1)
    Else
        sLeftOfDoubleNull = sLeftOfNull(sIn)
    End If
    
End Function

Public Function sLeftOfNull(ByVal sIn As String)
    'returns the part of sIn preceding Chr$(0)
    Dim lNullPos As Long
    
    'init output
    sLeftOfNull = sIn
    
    'get position of first Chr$(0) in sIn
    lNullPos = InStr(sIn, Chr$(0))
    
    'return part of sIn to left of first Chr$(0) if found
    If lNullPos > 0 Then
        sLeftOfNull = Mid$(sIn, 1, lNullPos - 1)
    End If
    
End Function

Sub DrawDisp(Canvas As PictureBox)
Dim xline%, yline%

    Const LtGrey = &HC0C0C0
    Const DkGrey = &H808080
    Const Green = &HFF00&
    Const Black = &H0&
    Const White = &HFFFFFF
    Canvas.AutoRedraw = True
    Canvas.Line (2 * xPixel, 2 * yPixel)-(142 * xPixel, 104 * yPixel), LtGrey, B
    Canvas.Line (xPixel, 105 * yPixel)-(144 * xPixel, 106 * yPixel), DkGrey, B
    Canvas.Line (2 * xPixel, 107 * yPixel)-(143 * xPixel, 107 * yPixel), Black
    Canvas.Line (143 * xPixel, yPixel)-(144 * xPixel, 106 * yPixel), DkGrey, BF
    Canvas.Line (0, 0)-(143 * xPixel, yPixel), White, BF
    Canvas.Line (0, 0)-(xPixel, 105 * yPixel), White, BF
    For xline = 3 To 141 Step 2
        Canvas.PSet (xline * xPixel, 2 * yPixel), White
    Next xline
    For xline = 2 To 140 Step 2
        Canvas.PSet (xline * xPixel, 3 * yPixel), White
    Next xline
    For yline = 3 To 105 Step 2
        Canvas.PSet (2 * xPixel, yline * yPixel), White
    Next yline
    For yline = 4 To 104 Step 2
        Canvas.PSet (3 * xPixel, yline * yPixel), White
    Next yline
    For xline = 6 To 140 Step 2
        Canvas.PSet (xline * xPixel, 103 * yPixel), DkGrey
    Next xline
    For xline = 5 To 141 Step 2
        Canvas.PSet (xline * xPixel, 104 * yPixel), DkGrey
    Next xline
    For yline = 3 To 101 Step 2
        Canvas.PSet (141 * xPixel, yline * yPixel), DkGrey
    Next yline
    For yline = 2 To 102 Step 2
        Canvas.PSet (142 * xPixel, yline * yPixel), DkGrey
    Next yline
    Canvas.Line (10 * xPixel, 5 * yPixel)-(134 * xPixel, 99 * yPixel), DkGrey, B
    Canvas.Line (11 * xPixel, 6 * yPixel)-(133 * xPixel, 98 * yPixel), Black, BF
    Canvas.Line (13 * xPixel, 8 * yPixel)-(132 * xPixel, 97 * yPixel), vbDesktop, BF
    Canvas.Line (10 * xPixel, 100 * yPixel)-(136 * xPixel, 100 * yPixel), White
    Canvas.Line (135 * xPixel, 5 * yPixel)-(135 * xPixel, 100 * yPixel), White
    Canvas.Line (38 * xPixel, 108 * yPixel)-(104 * xPixel, 109 * yPixel), DkGrey, BF
    Canvas.Line (103 * xPixel, 110 * yPixel)-(104 * xPixel, 111 * yPixel), DkGrey, BF
    Canvas.Line (102 * xPixel, 111 * yPixel)-(103 * xPixel, 112 * yPixel), DkGrey, BF
    Canvas.Line (101 * xPixel, 112 * yPixel)-(102 * xPixel, 113 * yPixel), DkGrey, BF
    Canvas.Line (100 * xPixel, 113 * yPixel)-(101 * xPixel, 114 * yPixel), DkGrey, BF
    Canvas.Line (39 * xPixel, 110 * yPixel)-(40 * xPixel, 111 * yPixel), White, BF
    Canvas.Line (40 * xPixel, 112 * yPixel)-(42 * xPixel, 112 * yPixel), White
    Canvas.Line (41 * xPixel, 113 * yPixel)-(43 * xPixel, 113 * yPixel), White
    Canvas.PSet (42 * xPixel, 114 * yPixel), White
    Canvas.Line (43 * xPixel, 114 * yPixel)-(100 * xPixel, 115 * yPixel), DkGrey, BF
    Canvas.Line (45 * xPixel, 116 * yPixel)-(101 * xPixel, 116 * yPixel), Black
    Canvas.Line (46 * xPixel, 117 * yPixel)-(96 * xPixel, 123 * yPixel), DkGrey, BF
    Canvas.Line (38 * xPixel, 126 * yPixel)-(105 * xPixel, 128 * yPixel), LtGrey, BF
    Canvas.Line (37 * xPixel, 124 * yPixel)-(106 * xPixel, 124 * yPixel), DkGrey
    Canvas.Line (37 * xPixel, 125 * yPixel)-(106 * xPixel, 125 * yPixel), White
    Canvas.Line (37 * xPixel, 129 * yPixel)-(106 * xPixel, 129 * yPixel), DkGrey
    Canvas.Line (36 * xPixel, 125 * yPixel)-(36 * xPixel, 129 * yPixel), DkGrey
    Canvas.Line (37 * xPixel, 125 * yPixel)-(37 * xPixel, 129 * yPixel), White
    Canvas.Line (106 * xPixel, 125 * yPixel)-(106 * xPixel, 129 * yPixel), DkGrey
    Canvas.Line (49 * xPixel, 119 * yPixel)-(94 * xPixel, 123 * yPixel), LtGrey, BF
    Canvas.Line (47 * xPixel, 119 * yPixel)-(48 * xPixel, 123 * yPixel), White, BF
    Canvas.Line (47 * xPixel, 117 * yPixel)-(48 * xPixel, 118 * yPixel), LtGrey, BF
    Canvas.Line (97 * xPixel, 116 * yPixel)-(97 * xPixel, 124 * yPixel), Black
    Canvas.Line (101 * xPixel, 115 * yPixel)-(106 * xPixel, 110 * yPixel), Black
    Canvas.Line (105 * xPixel, 107 * yPixel)-(105 * xPixel, 111 * yPixel), Black
    Canvas.Line (80 * xPixel, 109 * yPixel)-(91 * xPixel, 109 * yPixel), LtGrey
    Canvas.Line (80 * xPixel, 110 * yPixel)-(80 * xPixel, 113 * yPixel), White
    Canvas.Line (81 * xPixel, 112 * yPixel)-(91 * xPixel, 112 * yPixel), DkGrey
    Canvas.Line (90 * xPixel, 110 * yPixel)-(90 * xPixel, 113 * yPixel), DkGrey
    Canvas.Line (74 * xPixel, 109 * yPixel)-(78 * xPixel, 109 * yPixel), Black
    Canvas.Line (74 * xPixel, 110 * yPixel)-(74 * xPixel, 113 * yPixel), Black
    Canvas.Line (77 * xPixel, 110 * yPixel)-(77 * xPixel, 113 * yPixel), White
    Canvas.Line (75 * xPixel, 112 * yPixel)-(78 * xPixel, 112 * yPixel), White
    Canvas.Line (85 * xPixel, 110 * yPixel)-(86 * xPixel, 111 * yPixel), Green, BF
    Canvas.Line (39 * xPixel, 108 * yPixel)-(40 * xPixel, 109 * yPixel), LtGrey, BF
    Canvas.AutoRedraw = False
End Sub



Public Function CommDlg_OpenSave_GetFilePath$(hDlg&)
    '------------------------------------------
    'Returns the file name.  Provided to match
    'the C macro of the same name
    '------------------------------------------
    Dim lpString$, cdRet&
    lpString$ = Space$(260)
    cdRet = SendMessage(GetParent(hDlg), CDM_GETFILEPATH, Len(lpString), lpString)
    CommDlg_OpenSave_GetFilePath = sLeftOfNull(lpString)

End Function


Public Function OpenProc(ByVal hWnd As Long, ByVal MsgVal As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static DontProcess%
If DontProcess Then Exit Function
Dim NMHStruct As NMHDR
Dim context&, losstemp&, lpRetString$
Select Case fileaction
    Case FilePick
        Select Case MsgVal
            Case WM_NOTIFY
                CopyMemory2 NMHStruct, ByVal lParam, LenB(NMHStruct)
                Select Case NMHStruct.code
                    Case CDN_INITDONE
                        '-----------------------------------------------------------
                        'By default, Common dialogs do not have icons on the caption
                        'bar, but we can further customize the look of a subclassed
                        'dialog by placing the program icon there.  This will become
                        'a ControlBox, with Move and Close system menu options.
                        '-----------------------------------------------------------
                        SendMessage GetParent(hWnd), WM_SETICON, 0&, CLng(Form1.Icon)
                        Load DlgPic
                        PositionOpenControls (hWnd)
                        ShowWindow GetDlgItem(hWnd, IDC_CHECK1), SW_SHOWNORMAL
                        ShowWindow GetDlgItem(hWnd, IDC_LABEL1), SW_SHOWNORMAL
                        If AutoPreview Then
                            DontProcess = True
                            CheckDlgButton hWnd, IDC_CHECK1, 1&
                            DontProcess = False
                        Else
                            ShowWindow GetDlgItem(hWnd, IDC_BUTTON1), SW_SHOWNORMAL
                        End If
                    Case CDN_SELCHANGE
                        If AutoPreview Then
                            setpreview hWnd, True
                        Else
                            setpreview hWnd, False
                        End If
                    Case CDN_FOLDERCHANGE
                        setpreview hWnd, False
                    Case CDN_HELP
                        lRtn = MessageBoxAPI(hWnd, "There is no help file with this sample, but it would use this type of call to provide the associated help in context-sensitive fashion.", "Dialog Example", vbInformation Or vbOKOnly)
                        'context& = 13
                        'wCmd = HELP_CONTEXTPOPUP
                        'templong = WinHelp(hwnd, HelpFile$, wCmd, context)
                        '-------------------------------------------------
                End Select
                    
            Case WM_COMMAND
                Select Case wParam
                    Case IDC_BUTTON1
                        setpreview hWnd, True
                    Case IDC_CHECK1
                        AutoPreview = Not AutoPreview
                        If AutoPreview Then
                            setpreview hWnd, True
                            ShowWindow GetDlgItem(hWnd, IDC_BUTTON1), SW_HIDE
                        Else
                            ShowWindow GetDlgItem(hWnd, IDC_BUTTON1), SW_SHOWNORMAL
                        End If
                        '--------------------------------------------------
                        'If this were a real program we would save the value of
                        'the AutoPreview setting to the registry and reload at next
                        'program start.
                        '--------------------------------------------------
        
                End Select
    End Select
    Case FileSaveAs
        Select Case MsgVal
            Case WM_NOTIFY
                CopyMemory2 NMHStruct, ByVal lParam, LenB(NMHStruct)
                Select Case NMHStruct.code
                    Case CDN_INITDONE
                        SendMessage GetParent(hWnd), WM_SETICON, 0&, CLng(Form1.Icon)
                        '---------------------------------------------------
                        'All that is done here is to adjust the dialog size
                        'to the bottom of the logo, since other controls
                        'aren't used.  This is also where any optional controls
                        'could be placed to match screen resolution differences.
                        '---------------------------------------------------
                        PositionSaveControls (hWnd)
                    Case CDN_TYPECHANGE
                        '----------------------------------------------
                        'This would happen if the user has changed the
                        'SaveAs type, and could be used to alter the dialog
                        'if needed - for example to provide a control for
                        'JPG options if the program uses a graphics control
                        'capable of JPG saves.
                        '----------------------------------------------
                    Case CDN_FILEOK
                        '-----------------------------------------------
                        'Use this message to check information from any
                        'dialog element when the user has clicked OK.  May
                        'even be used to stop the dialog from unloading by
                        'using SetWindowLong(hdlg, DWL_MSGRESULT, lResult)
                        'where hdlg is GetParent(hwnd) and lResult is not zero.
                        '---------------------------------------------------
                    Case CDN_HELP
                        '----------------------------------------------
                        lRtn = MessageBoxAPI(hWnd, "There is no help file with this sample, but it would use this type of call to provide the associated help in context-sensitive fashion.", "Dialog Example", vbInformation Or vbOKOnly)
                        'context& = 14
                        'wCmd = HELP_CONTEXTPOPUP
                        'templong = WinHelp(hwnd, HelpFile$, wCmd, context)
                        '----------------------------------------------
                End Select
    End Select
    Case FileMultiPick
        Select Case MsgVal
            Case WM_NOTIFY
                CopyMemory2 NMHStruct, ByVal lParam, LenB(NMHStruct)
                Select Case NMHStruct.code
                    Case CDN_INITDONE
                        SendMessage GetParent(hWnd), WM_SETICON, 0&, CLng(Form1.Icon)
                        '-------------------------------------------------------------
                        'Example of changing the text of one of the standard controls
                        SendMessage GetParent(hWnd), CDM_SETCONTROLTEXT, ID_OPEN, "Pick"
                        '-------------------------------------------------------------
                        Load DlgPic
                        PositionOpenControls (hWnd)
                        ShowWindow GetDlgItem(hWnd, IDC_CHECK1), SW_SHOWNORMAL
                        ShowWindow GetDlgItem(hWnd, IDC_LABEL1), SW_SHOWNORMAL
                        If AutoPreview Then
                            DontProcess = True
                            CheckDlgButton hWnd, IDC_CHECK1, 1&
                            DontProcess = False
                        Else
                            ShowWindow GetDlgItem(hWnd, IDC_BUTTON1), SW_SHOWNORMAL
                        End If
                    Case CDN_SELCHANGE
                        If AutoPreview Then
                            setpreview hWnd, True
                        Else
                            setpreview hWnd, False
                        End If
                    Case CDN_FOLDERCHANGE
                        setpreview hWnd, False
                    Case CDN_HELP
                        '------------------------------------------------
                        lRtn = MessageBoxAPI(hWnd, "There is no help file with this sample, but it would use this type of call to provide the associated help in context-sensitive fashion.", "Dialog Example", vbInformation Or vbOKOnly)
                        'context& = 13
                        'wCmd = HELP_CONTEXTPOPUP
                        'templong = WinHelp(hwnd, HelpFile$, wCmd, context)
                        '------------------------------------------------
                End Select
                    
            Case WM_COMMAND
                Select Case wParam
                    Case IDC_BUTTON1
                        setpreview hWnd, True
                    Case IDC_CHECK1
                        AutoPreview = Not AutoPreview
                        If AutoPreview Then
                            setpreview hWnd, True
                            ShowWindow GetDlgItem(hWnd, IDC_BUTTON1), SW_HIDE
                        Else
                            ShowWindow GetDlgItem(hWnd, IDC_BUTTON1), SW_SHOWNORMAL
                        End If
        
                End Select
    End Select
    Case ChoosePath
        Select Case MsgVal
            Case WM_NOTIFY
                CopyMemory2 NMHStruct, ByVal lParam, LenB(NMHStruct)
                Select Case NMHStruct.code
                    Case CDN_INITDONE
                        'PositionSaveControls (hwnd)
                        SendMessage GetParent(hWnd), CDM_HIDECONTROL, ID_FILELABEL, ByVal 0&
                        SendMessage GetParent(hWnd), CDM_HIDECONTROL, ID_FILETEXT, ByVal 0&
                        SendMessage GetParent(hWnd), CDM_HIDECONTROL, ID_FILETYPELABEL, ByVal 0&
                        SendMessage GetParent(hWnd), CDM_HIDECONTROL, ID_FORMAT, ByVal 0&
                        SendMessage GetParent(hWnd), CDM_SETCONTROLTEXT, ID_FILETEXT, ByVal "Junk"
                        SendMessage GetParent(hWnd), CDM_SETCONTROLTEXT, ID_OPEN, ByVal "Select"
                    Case CDN_SELCHANGE
                        SendMessage GetParent(hWnd), CDM_SETCONTROLTEXT, ID_FILETEXT, ByVal "Junk"
                    Case CDN_FOLDERCHANGE
                        SendMessage GetParent(hWnd), CDM_SETCONTROLTEXT, ID_FILETEXT, ByVal "Junk"
                    Case CDN_TYPECHANGE
                        SendMessage GetParent(hWnd), CDM_SETCONTROLTEXT, ID_FILETEXT, ByVal "Junk"
                End Select
    End Select
End Select
End Function
Public Function colorProc(ByVal hWnd As Long, ByVal MsgVal As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim ctlhWnd&
Static inited%
    Select Case MsgVal
        Case WM_INITDIALOG
            '-----------------------------------------------------------
            'Simple things are done here, such as a custom ControlBox icon, but you
            'could use the hwnd to programmatically set and retrieve data
            'in the color dialog.
            '-----------------------------------------------------------
            SendMessage hWnd, WM_SETICON, 0&, CLng(Form1.Icon)
            SetWindowText hWnd, "New Colors"
            ctlhWnd = GetDlgItem(hWnd, &HFFFF&)
            '-----------------------------------------------------------
            'This demonstrates finding a label and changing its text:
            '-----------------------------------------------------------
            SetWindowText ctlhWnd, "Leave"
            ctlhWnd = FindWindowEx(hWnd, ctlhWnd, vbNullString, "&Custom Colors:")
            SetWindowText ctlhWnd, "Don't Leave"
    End Select
End Function

Public Function PrintProc(ByVal hWnd As Long, ByVal MsgVal As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    PrintProc = 0
End Function

Public Function FontProc(ByVal hWnd As Long, ByVal MsgVal As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case MsgVal
        Case WM_INITDIALOG
            '-----------------------------------------------------------
            'The only thing done here is to set a ControlBox icon, but you
            'could use the hwnd to programmatically set and retrieve data
            'in the font dialog.
            '-----------------------------------------------------------
            SendMessage hWnd, WM_SETICON, 0&, CLng(Form1.Icon)
    End Select
End Function


Sub DoSaveAs()
Dim sPathtemp$, filterstring$
    If Form1.Image1(1).Picture = 0 Then
        MsgBox "No image available to save"
        Exit Sub
    End If
    fileaction = FileSaveAs
    saveformat = 0
    Dim objSaveDialog As New clsCommonDialog
    With objSaveDialog
        parsepath Image1FileName
        Select Case parsed.filetype
            Case ".ico"
                filterstring = "Windows Icon|*.ico|"
            Case ".wmf"
                filterstring = "Windows Meta File|*.wmf|"
            Case ".emf"
                filterstring = "Enhanced Meta File|*.emf|"
        End Select
        filterstring = filterstring & "Windows Bitmap|*.bmp"
        .Filter = filterstring
        .DialogTitle = "Save File As"
        .CancelError = True
        sPathtemp = LastSavedPath
        If Right$(sPathtemp, 1) = "\" Then
            sPathtemp = Left$(LastSavedPath, Len(LastSavedPath) - 1)
        End If
        ChangeDefExt = False
        .InitDir = sPathtemp
        .FilterIndex = 1
        .FLAGS = cdlOFNHelpButton Or _
            cdlOFNHideReadOnly
        If winOS <> OldNT Then
            'NT 3.51 users will not see the subclassed dialog
            .FLAGS = .FLAGS Or _
                cdlOFNEnableTemplate Or cdlOFNEnableHook Or _
                cdlOFNExplorer
            .HookAddress = pAddressOf(AddressOf OpenProc)
            .TemplateID = DLG_OPENFILE
        End If
        .hWnd = Form1.hWnd
        .FileName = parsed.FileName
        .DefaultExt = parsed.filetype
        .ShowSave
        result = .FileName
        If .ExtendedError <> 0 Then
            Select Case .ExtendedError
                Case CDERR_FINDRESFAILURE
                    MsgBox "The template resource could not be found"
                Case CDERR_LOADRESFAILURE
                    MsgBox "The template resource could not be loaded"
                Case CDERR_NOTEMPLATE
                    MsgBox "No resource template was specified"
            End Select
            result = ""
        End If
    End With
    Set objSaveDialog = Nothing
    If result = "" Then
        Exit Sub
    End If
    parsepath result
    '-------------------------------------------------
    'In a full program the file should be checked for
    'existence and an overwrite prompt given when needed
    '-------------------------------------------------
    If parsed.filetype = ".bmp" Then
        '----------------------------------------------------
        'The Image property is always saved as .BMP, regardless
        'of loaded type.  Since the Image control does not have
        'an image property the picture is reloaded into a Picture
        'Box control and saved from there.  The format of the
        'loaded image could be checked and used if it were .BMP,
        'but that step isn't implemented here.
        '----------------------------------------------------
        Load DlgPic
        DlgPic.Picture1.Picture = LoadPicture(Image1FileName)
        SavePicture DlgPic.Picture1.Image, result
    Else
        SavePicture Form1.Image1(1).Picture, result
    End If
    LastSavedPath = parsed.filepath

End Sub



Sub PositionOpenControls(hWnd&)
Dim dlgPoint As POINTAPI, rcDialog As RECT, ButtonHeight&, ButtonWidth&
Dim ButtonLeft&, ButtonTop&, DlgTop&, dlgHeight&, rcClient As RECT, ButtonBottom&
Dim screenrect As RECT, lTempLong&
        '---------------------------------------------------------------
        'Position the Preview button relative to the Help button by
        'getting the location and size of the help button.
        '---------------------------------------------------------------
        GetWindowRect GetDlgItem(GetParent(hWnd), ID_HELP), rcDialog
        ButtonHeight = rcDialog.Bottom - rcDialog.Top
        ButtonWidth = rcDialog.Right - rcDialog.Left
        dlgPoint.x = rcDialog.Left
        dlgPoint.y = rcDialog.Bottom + 6
        ScreenToClient hWnd, dlgPoint
        ButtonLeft = dlgPoint.x
        ButtonTop = dlgPoint.y
        MoveWindow GetDlgItem(hWnd, IDC_BUTTON1), ButtonLeft, ButtonTop, ButtonWidth, ButtonHeight, 0

        '---------------------------------------------------------------
        'Position the AutoPreview Check Button relative to the Preview
        'Button.
        '---------------------------------------------------------------
        GetWindowRect GetDlgItem(hWnd, IDC_CHECK1), rcDialog
        ButtonHeight = rcDialog.Bottom - rcDialog.Top
        ButtonWidth = rcDialog.Right - rcDialog.Left
        GetWindowRect GetDlgItem(hWnd, IDC_BUTTON1), rcDialog
        dlgPoint.x = rcDialog.Left
        dlgPoint.y = rcDialog.Bottom + 6
        ScreenToClient hWnd, dlgPoint
        ButtonLeft = dlgPoint.x
        ButtonTop = dlgPoint.y
        MoveWindow GetDlgItem(hWnd, IDC_CHECK1), ButtonLeft, ButtonTop, ButtonWidth, ButtonHeight, 0
        
        '----------------------------------------------------------------
        'Put the preview display on the dialog, and position it to the left
        'of the check box and below the Format Combo box.
        '----------------------------------------------------------------
        SetParent DlgPic.picPreview.hWnd, GetParent(hWnd)
        GetWindowRect GetDlgItem(GetParent(hWnd), ID_FORMAT), rcDialog
        dlgPoint.x = rcDialog.Left
        dlgPoint.y = rcDialog.Bottom
        ScreenToClient GetParent(hWnd), dlgPoint
        DlgPic.picPreview.Move (ButtonLeft - 160) * xPixel, (dlgPoint.y + 5) * yPixel, 150 * xPixel, 131 * yPixel
        
        '---------------------------------------------------------------
        'Position the logo relative to the icon
        '---------------------------------------------------------------
        GetWindowRect GetDlgItem(hWnd, IDC_LOGOICON), rcDialog
        dlgPoint.y = rcDialog.Bottom
        dlgPoint.x = rcDialog.Right + 3
        ScreenToClient hWnd, dlgPoint
        GetWindowRect GetDlgItem(hWnd, IDC_LOGOTEXT), rcDialog
        ButtonLeft = dlgPoint.x
        ButtonWidth = rcDialog.Right - rcDialog.Left
        ButtonHeight = rcDialog.Bottom - rcDialog.Top
        ButtonTop = dlgPoint.y - ButtonHeight
        MoveWindow GetDlgItem(hWnd, IDC_LOGOTEXT), ButtonLeft, ButtonTop, ButtonWidth, ButtonHeight, 0
        
        '----------------------------------------------------------------
        'Since we have extended the dialog box downward, we will figure its
        'height and make sure it is all on screen, accounting for taskbar
        '----------------------------------------------------------------
        lTempLong = SystemParametersInfo(SPI_GETWORKAREA, 0&, screenrect, 0&)
        GetWindowRect GetParent(hWnd), rcDialog
        GetClientRect GetParent(hWnd), rcClient
        DlgTop = rcDialog.Top
        dlgHeight = DlgPic.picPreview.Top / yPixel + 132 + rcDialog.Bottom - rcDialog.Top - rcClient.Bottom
        If DlgTop + dlgHeight > screenrect.Bottom Then
            DlgTop = screenrect.Bottom - dlgHeight
        End If
        MoveWindow GetParent(hWnd), rcDialog.Left, DlgTop, rcDialog.Right - rcDialog.Left, dlgHeight, 0
        
        '----------------------------------------------------------------
        'Draw the monitor image on the picture box.
        '----------------------------------------------------------------
        DrawDisp DlgPic.picPreview
End Sub

Private Function PreviewClick$(filepath$)
Dim tempfile$, imageformat1&
        On Error GoTo loaderror
        Set DlgPic.Picture1.Picture = LoadPicture(filepath)
        PreviewClick = Format$(DlgPic.Picture1.ScaleWidth) & "x" & Format$(DlgPic.Picture1.ScaleHeight) & " Pixels"
        DlgPic.imgpreview.Visible = False
        If DlgPic.Picture1.ScaleWidth / DlgPic.Picture1.ScaleHeight > 4 / 3 Then
            DlgPic.imgpreview.Height = DlgPic.Picture1.ScaleHeight / DlgPic.Picture1.ScaleWidth * 120 * xPixel
            DlgPic.imgpreview.Width = 120 * xPixel
        Else
            DlgPic.imgpreview.Width = DlgPic.Picture1.ScaleWidth / DlgPic.Picture1.ScaleHeight * 90 * yPixel
            DlgPic.imgpreview.Height = 90 * yPixel
        End If
        DlgPic.imgpreview.Picture = DlgPic.Picture1.Picture
        DlgPic.imgpreview.Top = 8 * yPixel + (90 * yPixel - DlgPic.imgpreview.Height) / 2
        DlgPic.imgpreview.Left = 13 * xPixel + (120 * xPixel - DlgPic.imgpreview.Width) / 2
        DlgPic.imgpreview.Visible = True
        Exit Function
loaderror:
DlgPic.imgpreview.Visible = False
Exit Function
End Function


Sub doLoadSingleFile(lOpentype&)
Dim sPathtemp$
    fileaction = FilePick
    Dim objOpenDialog As New clsCommonDialog
    With objOpenDialog
        .Filter = "All Supported Formats|*.BMP;*.ICO;*.RLE;*.WMF;*.EMF;*.GIF;*.JPG|Windows Bitmap (BMP)|*.BMP|Windows Icons (ICO)|*.ICO|Windows Bitmap (RLE)|*.RLE|Windows Meta File (WMF)|*.WMF|Enhanced Meta File (EMF)|*.EMF|Compuserve (GIF)|*.GIF|JPEG (JPG)|*.JPG"
        .DialogTitle = "Choose file to open"
        .CancelError = True
        sPathtemp = LastLoadedPath
        If Right$(sPathtemp, 1) = "\" Then
            sPathtemp = Left$(LastLoadedPath, Len(LastLoadedPath) - 1)
        End If
        .InitDir = sPathtemp
        .FilterIndex = filterloadposition
        .FLAGS = cdlOFNFileMustExist Or _
            cdlOFNHelpButton Or cdlOFNHideReadOnly
        If lOpentype = SubClassed And winOS <> OldNT Then
            'NT 3.51 users will not see the subclassed dialog
            .FLAGS = .FLAGS Or _
                cdlOFNEnableTemplate Or cdlOFNEnableHook Or _
                cdlOFNExplorer
            '-----------------------------------------------------------
            'HookAddress is an added dialog property for the Open and Save
            'dialogs.  Provide a function pointer to allow processing of
            'messages from the dialog.
            '-----------------------------------------------------------
            .HookAddress = pAddressOf(AddressOf OpenProc)
            '-----------------------------------------------------------
            'TemplateID is an added dialog property for the Open and Save
            'dialogs.  Provide an ID number for a custom template contained
            'in a resource file.
            '-----------------------------------------------------------
            .TemplateID = DLG_OPENFILE
        End If
        .hWnd = Form1.hWnd
        .ShowOpen
        '------------------------------------------
        'The picturebox gets destroyed when the dialog
        'exits, so unload its parent form
        '------------------------------------------
        Unload DlgPic
        result = .FileName
        If .ExtendedError <> 0 Then
            Select Case .ExtendedError
                Case CDERR_FINDRESFAILURE
                    MsgBox "The template resource could not be found"
                Case CDERR_LOADRESFAILURE
                    MsgBox "The template resource could not be loaded"
                Case CDERR_NOTEMPLATE
                    MsgBox "No resource template was specified"
            End Select
            result = ""
        End If
    End With
    Set objOpenDialog = Nothing
    If result = "" Then
        Exit Sub
    End If
    parsepath result
    On Error GoTo loaderror
    Form1.Image1(1).Picture = LoadPicture(result)
    Image1FileName = result
    LastLoadedPath = parsed.filepath
    Exit Sub
loaderror:
    If Err = 50003 Then
        MsgBox "cannot read JPG or GIF files"
    End If
    Exit Sub
End Sub

Function pAddressOf(ByVal procaddr As Long) As Long
    pAddressOf = procaddr
End Function



Sub setlabellength(framelabel As Control)
Dim temptext$
temptext = framelabel.Caption
framelabel.Caption = ""
framelabel.Caption = temptext

End Sub

Sub setpreview(hWnd&, bAction%)
Dim LabelString$
    If bAction Then
        LabelString = PreviewClick(CommDlg_OpenSave_GetFilePath(hWnd))
        SetDlgItemText hWnd, IDC_LABEL1, LabelString
    Else
        DlgPic.imgpreview.Visible = False
        SetDlgItemText hWnd, IDC_LABEL1, ""
    End If
End Sub

